Data Processing
Read in Data
zones <- st_read("K:\\Projects\\WILMAPCO\\Features\\Model\\SE\\Zones_2050.shp", quiet = TRUE) %>%
select(Zone)
zones <- ms_simplify(zones)
trips <- read.dbf("K:\\Projects\\WILMAPCO\\Features\\Model\\skims_trips\\mr50_pk_am_trips.dbf")
skims <- read.dbf("K:\\Projects\\WILMAPCO\\Features\\Model\\skims_trips\\mr50_congested_time_distance.dbf")
study_area_zones <- read.dbf("K:\\Projects\\WILMAPCO\\Features\\Model\\SE\\Zones_2050.dbf") %>% select(Zone, RFP_bound)
study_area_zones$RFP_bound <- replace_na(study_area_zones$RFP_bound, 0)
Calculate total AM trips by all modes (model does not contain nonmotorized) for all zone-to-zone flows
trips <- trips %>%
mutate(TRIPS = rowSums(.[3:12])) %>%
select(F_TAZ, T_TAZ, TRIPS)
skims_trips <- left_join(trips, skims)
Add MPH, PMT, PHT calculations for all zone-to-zone flows
skims_trips <- skims_trips %>% mutate(MPH = DIST / (TIME/60),
PMT = DIST * TRIPS,
PHT = PMT / MPH)
skims_trips$MPH[is.nan(skims_trips$MPH)] <- 0
skims_trips$PMT[is.nan(skims_trips$PMT)] <- 0
skims_trips$PHT[is.nan(skims_trips$PHT)] <- 0
Summarize results to the “from persepctive”
#group by "from" TAZ and add up sum of relevant columns
from_summarized <- skims_trips %>%
select(-T_TAZ, -MPH) %>%
group_by(F_TAZ) %>%
summarise_all(sum) %>%
ungroup()
#calculate speed, length, and density based on summarized values
from_summarized <- from_summarized %>%
mutate(MPH = PMT/PHT,
LENGTH = PMT/TRIPS,
TRIP_DENSITY = 1/LENGTH)
Plot Results
Scatterplot of speed and trip density (all zones)
#add study area designation flag
from_summarized <- inner_join(from_summarized, study_area_zones, by = c("F_TAZ" = "Zone"))
from_summarized$RFP_zone[from_summarized$RFP_bound==1] <- "Study Area"
from_summarized$RFP_zone[from_summarized$RFP_bound==0] <- "Outside Study Area"
scatterplot <- ggplot(from_summarized, aes(x=TRIP_DENSITY, y=MPH, color = RFP_zone, text = paste0("TAZ: ", F_TAZ))) +
geom_point() +
scale_color_rpg(palette = "rpg_colors")
ggplotly(scatterplot, tooltip = c("x", "y", "text")) %>%
layout(legend = list(orientation = "h", x = 0.4, y = -0.3))
Map of Trip Density by Origin TAZ
from_summarized_sf <- right_join(zones, from_summarized,
by = c("Zone" = "F_TAZ"))
tmap_mode("view")
pal <- rpg_color_pal("rpg_orange_ramp")(6)
tm_shape(from_summarized_sf) +
tm_fill("TRIP_DENSITY", style="quantile", n = 6, palette = pal) +
tm_borders(lwd = 0.5)
Table of Summarized Values by Origin TAZ
colnames <- colnames(from_summarized[2:9])
datatable(from_summarized) %>% formatRound(colnames)
Re-calculate “from perspective” after filtering to only include skim TAZs that appear in shapefile
#filter skims
skims_trips_filtered <- skims_trips %>%
filter(F_TAZ %in% zones$Zone,
T_TAZ %in% zones$Zone)
#group filtered skims by "from" TAZ and add up sum of relevant columns
from_summarized_filtered <- skims_trips_filtered %>%
select(-T_TAZ, -MPH) %>%
group_by(F_TAZ) %>%
summarise_all(sum) %>%
ungroup()
#calculate speed, length, and density based on summarized values
from_summarized_filtered <- from_summarized_filtered %>%
mutate(MPH = PMT/PHT,
LENGTH = PMT/TRIPS,
TRIP_DENSITY = 1/LENGTH)
Scatterplot of filtered Speed and Trip Density
#add study area designation flag
from_summarized_filtered <- inner_join(from_summarized_filtered, study_area_zones, by = c("F_TAZ" = "Zone"))
from_summarized_filtered$RFP_zone[from_summarized_filtered$RFP_bound==1] <- "Study Area"
from_summarized_filtered$RFP_zone[from_summarized_filtered$RFP_bound==0] <- "Outside Study Area"
scatterplot_filtered <- ggplot(from_summarized_filtered, aes(x=TRIP_DENSITY, y=MPH, color = RFP_zone, text = paste0("TAZ: ", F_TAZ))) +
geom_point() +
scale_color_rpg(palette = "rpg_colors")
ggplotly(scatterplot_filtered, tooltip = c("x", "y", "text")) %>%
layout(legend = list(orientation = "h", x = 0.4, y = -0.3))
Map of Filtered Trip Density by Origin TAZ
from_summarized_filtered_sf <- right_join(zones, from_summarized_filtered,
by = c("Zone" = "F_TAZ"))
tmap_mode("view")
pal <- rpg_color_pal("rpg_orange_ramp")(6)
tm_shape(from_summarized_filtered_sf) +
tm_fill("TRIP_DENSITY", style="quantile", n = 6, palette = pal) +
tm_borders(lwd = 0.5)
Table of Summarized Filtered Values by Origin TAZ
colnames <- colnames(from_summarized_filtered[2:9])
datatable(from_summarized_filtered) %>% formatRound(colnames)
#write_csv(from_summarized, "D:\\Users\\CO7\\OneDrive - Renaissance Planning Group\\Wilmapco\\from_scenario.csv")